Warning: ✖ Expecting the following names to be in the data frame: .conf_hi, .conf_lo.
ℹ Proceeding with '.conf_interval_show = FALSE' to visualize the forecast without confidence intervals.
Alternatively, try using `modeltime_calibrate()` before forecasting to add confidence intervals.
# Prepare future data for predictionfuture_tbl <- poudre_flow %>%bind_rows(tibble(Date =seq.Date(from =as.Date("2024-01-01"),by ="month", length.out =12),Flow =NA) )# Refit and forecast next 12 monthsrefit_tbl <- models_tbl %>%modeltime_refit(data = poudre_flow)
Disabling weekly seasonality. Run prophet with weekly.seasonality=TRUE to override this.
Disabling daily seasonality. Run prophet with daily.seasonality=TRUE to override this.
frequency = 12 observations per 1 year
# Generate predictions for future datapred_tbl <- refit_tbl %>%modeltime_forecast(new_data = future_tbl,actual_data = poudre_flow ) %>%filter(.key =="prediction") # Ensure you're getting predictions, not actual values# Ensure the Date column is correctly formattedpred_tbl$Date <-as.Date(pred_tbl$.index)# Check the structure and the first few rows of predictionshead(pred_tbl)
# Rename .value to Predicted in pred_tblpred_tbl <- pred_tbl %>%rename(Predicted = .value)# Join predictions with observed datacomparison <-left_join(pred_tbl, obs_2024, by ="Date") %>%filter(!is.na(Observed))# Check the first few rows of the joined datahead(comparison)
# Fit the linear modellm_model <-lm(Observed ~ Predicted, data = comparison)# Print the model summarysummary(lm_model)
Call:
lm(formula = Observed ~ Predicted, data = comparison)
Residuals:
Min 1Q Median 3Q Max
-76.483 -32.041 -2.972 30.753 73.597
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 43.0574 8.9601 4.805 8.45e-05 ***
Predicted 0.3132 0.0270 11.598 7.63e-11 ***
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 40.1 on 22 degrees of freedom
Multiple R-squared: 0.8594, Adjusted R-squared: 0.8531
F-statistic: 134.5 on 1 and 22 DF, p-value: 7.625e-11
Compute R^2
lm_model <-lm(Observed ~ Predicted, data = comparison)summary(lm_model)$r.squared
[1] 0.8594398
Plot Predicted vs Observed
# Plot Predicted vs Observed with 1:1 line and linear model lineggplot(comparison, aes(x = Predicted, y = Observed)) +geom_point() +geom_abline(slope =1, intercept =0, color ="red") +# 1:1 linegeom_smooth(method ="lm", color ="blue") +# Linear regression linelabs(title ="Predicted vs Observed Streamflow",x ="Predicted Flow",y ="Observed Flow")